5.2.2 构建背景数据集

5.2.2.1 基于地理空间构建背景点
##构建随机点:
bg <- randomPoints(modelEnv, 1000)
## 方法1:构建具有空间坐标系的随机点;
set.seed(1) 
bg <- sampleRandom(x=clim_mask,
                   size=10000,
                   na.rm=T, #removes the 'Not Applicable' points  
                   sp=T) # return spatial points 

## 方法2:构建环境buffer采样:
> file <- paste(system.file(package="dismo"), '/ex/acaule.csv', sep="")
> ac <- read.csv(file)
> coordinates(ac) <- ~lon+lat
> projection(ac) <- CRS(✬+proj=longlat +datum=WGS84✬)
> # circles with a radius of 50 km
> x <- circles(ac, d=50000, lonlat=TRUE)
> pol <- polygons(x)
> # sample randomly from all circles
> samp1 <- spsample(pol, 250, type=✬random✬, iter=25)
> # get unique cells
> cells <- cellFromXY(mask, samp1)
> cells <- unique(cells)
xy <- xyFromCell(mask, cells)
> plot(pol, axes=TRUE)
> points(xy, cex=0.75, pch=20, col='blue')
## 上面那种方法构建的随机点可能会在物种buffer之外,因此需要保证分布点再buffer之内,方法是:
> spxy <- SpatialPoints(xy, proj4string=CRS(✬+proj=longlat +datum=WGS84✬))
> o <- over(spxy, geometry(x))
> xyInside <- xy[!is.na(o), ]


## 在地理空间中投影可能并不与实际生活相符,因此可能需要使用投影坐标系来处理:
## 这里是将数据先转为平面坐标系,计算欧式距离,再转回来!
# install.packages("devtools") # if you do not have devtools, then install it
devtools::install_github("valentinitnelav/geobuffer")
library(geobuffer)

pts <- data.frame(lon = c(-53.20198, -52.81218),
                  lat = c(47.05564, 47.31741))

pts_buf_100km <- geobuffer_pts(xy = pts, dist_m = 100*10^3)
5.2.2.2 基于环境背景构建背景点
## 构建背景点:
rm(list = ls())
setwd("C://Users//admin//Desktop")
## 0.5度大约50-55km;0.25度大约25-30km;0.125度(7.5min)大约15-10km左右;
library(SDMtune)
library(ENMeval)
library(raster)
library(rgdal)
library(maps)
library(mapdata)
library(dismo)
library(rJava)
library(maptools)
library(jsonlite)
library(glmnet)
library(maxnet)
library(rasterVis)
library(ggplot2)
##检查maxent是否可用:
dismo::maxent()
## 准备建模数据:
## 加载物种分布数据:####
## occs:
xh_na <- read.csv("C:/Users/Administrator/Desktop/xh/na.csv")[,2:3]
xh_as <- read.csv("C:/Users/Administrator/Desktop/xh/as.csv")[,2:3]
xh_eu <- read.csv("C:/Users/Administrator/Desktop/xh/eu.csv")[,2:3]
xh_au <- read.csv("C:/Users/Administrator/Desktop/xh/au.csv")[,2:3]
xh_sa <- read.csv("C:/Users/Administrator/Desktop/xh/sa.csv")[,2:3] 
xh_ynbd <- read.csv("C:/Users/Administrator/Desktop/xh/ynbd.csv")[,2:3] 
head(xh_as)

# C:/Users/Administrator/Desktop/xh
# C:/Users/Administrator/Desktop/bg_area_enm
####  加载环境数据:#####
tifs <- list.files(path ="C:/Users/Administrator/Desktop/bg_area_enm/as_area",pattern="asc",full.names =T)
tiffs <- stack(tifs)
crs.geo <- CRS("+proj=longlat +ellps=WGS84 +datum=WGS84")  
proj4string(tiffs) <- crs.geo  
envs <- tiffs
## 加载物种发生点:
occs <- xh_as

## 利用发生点构建背景点:
## 因为环境范围应掩膜,直接在给定区域建立随机背景点分布:
bg.xy <- dismo::randomPoints(tiffs$BIO1, 3000,p= occs)
bg_xy <- as.data.frame(bg.xy,colnames(c("long","lat")))


# Create SWD object
data <- prepareSWD(species = "xh_sa species", 
                   p =occs , a = bg_xy, 
                   env = envs)

data
## 构建训练接:高精度建模:

## 使用空间棋盘法:
cb_folds <- get.checkerboard1(occ = data@coords[data@pa == 1, ],
                              env = envs,
                              bg.coords = data@coords[data@pa == 0, ],
                              aggregation.factor = 4)

model <- train(method = "Maxnet", data = data,folds = cb_folds)

h <- list(reg = seq(0.5, 4, 0.5), fc = c("lq", "lh", "lqp", "lqph", "lqpht"))
om <- optimizeModel(model, hypers = h, metric = "auc", seed = 4,gen=40)
head(om@results)[1,]  # Best combinations

results matching ""

    No results matching ""